#|_____________________________________________________________________
 |
 | plots000.lsp
 | Main entry point for the ViSta Plots, Views and Corkboards System
 | Copyright 2001-2002 by Forrest W. Young
 |
 | The PLOTS, VIEWS, and SKETCHES system consists of:
 |
 | 1 - New PLOT OBJECTS and PLOTS menu
 |
 |     The new PLOT objects work from the menubar and have a consistent
 |     syntax which works from the listener. The previous plot objects
 |     still work from the menubar, and never worked from the listener.
 |     
 |     The PLOTS menu provides user access to the new PLOT objects
 |
 |     Files plots00x.lsp contains the code that implements PLOT objects.
 |     The PLOTS menu code is in vismenu1.lsp
 |.
 |     This code is working very smoothly. It does not interfeer
 |     with the operation of the classic spreadplots. The menu items
 |     respond to the current data's datatype.
 | 
 | 2 - New VIEW OBJECTS and VIEWS menu
 |
 |     The new VIEWS (spreadplot) objects use the new PLOT objects.
 |     The new views do not interfere with previously created 
 |     spreadplots which continue to used the old graphics objects.
 |
 |     File views001.lsp contains the code that implements the
 |     current VIEWS objects.
 | 
 |     Currently, VIEWS objects are no different than spreadplot  
 |     objects, other than that they; use the new PLOT objects.
 |     They should work with the old code too, but there is no
 |     reason to do this.
 | 
 |     The VIEWS object code should be modified to be based on the 
 |     function names and capabilities in our GOSSIP paper. There 
 |     can be a simple many-to-one mapping of old spreadplot functions 
 |     onto the new GOSSIP function.
 |
 |     The VIEWS menu provides user access to the views, both new and old
 |
 |     The VIEWS menu code is in vismenu1.lsp
 |
 |     Some of the items of the VIEWS menu are never enabled. This is because
 |     the code for these parts does not currently work. I believe that the
 |     reason it doesn't work right is that it uses old function names for
 |     the plot objects. Since the names of the plot objects are now stable
 |     the remaining VIEWS Objects and Menu items should be worked on next.
 |
 | 3 - ViSta ETCH-A-SKETCH OBJECT:   
 |     The ETCH-A-SKETCH object is a GUI for creating new spreadplots
 |     The code in file sketch01.lsp loads this part of the code.
 |
 |     This code does not work, other than putting up a Etch-a-Sketch window.
 |     The code is only a skeleton of the concept. Much work needs to be done.
 |
 |_______________________________________________________________________
 |#
 
#|

About Using the new VISTA PLOT objects

Each plot is generated by a function called the plot constructor function. The various plot constructor functions have an optional DATA argument and several KEYWORD arguments. If no arguments are used, a default plot is constructed from information in $, the current data. The information that is used is the first few variables in the list of all variables of the appropriate variable types. The number of vectors that are used depends on the details of the plot, as does the defintion of the appropriate variable types. The plot is shown in its' own window (i.e., not inside a container window), although the menu system may override this default.
 
All plots share the following arguments and syntax:

    (PLOT-CONSTRUCTOR-NAME &optional DATA &key KEYWORD-ARGUMENTS)

The optional DATA argument may be omitted ormay be NIL, or may be a data object, a list of numeric or string elements, a list of variable objects, a list of equal-length lists, a vector, a list of equal-length vectors, or a matrix. If omitted or NIL, DATA is assumed to be $, the current dataobject. In all cases, DATA is converted into a list of equal-length vectors. one vector for each of the OK-VAR-TYPES (see below) variables in the referenced data object.

The plot is constructed from the first few vectors in the list of vectors, the number of vectors depending on the details of the plot. If you need to use any of the keyword arguments, the data must be specified, and it must be mentioned before the keywords.

The keyword arguments consist of STANDARD keyword arguments (which are used by all of the plots and which are discussed here) and UNIQUE keyword arguments (which are unique to each plot and which are discussed in the help for each plot). If you need to use any of the keyword arguments, the data must be specified (perhaps as nil or $) before the keywords are specified. The standard keyword arguments (with defaults in parentheses, if appropriate) are:

ok-var-types    a list of symbols or strings of usable variable types
variable-labels a list of strings, one for each variable 
way-labels      an alias of :VARIABLE-LABELS for some graphs
point-labels    a list of strings, one per point 
in  (unused)    T, NIL, UNUSED or CONTAINER - sets the container window.
show     (T)    T or NIL indicating if the plot is shown when created
top-most (T)    T or NIL sets initial always-on-top state
go-away  (T)    T or NIL sets if the close box is functional
location        a list (x y) locating the plot's upper-left corner 
size size       a list (w h) of the plot's width & height 
title           a string shown as the window title
legend1         a string for the first line of the legend 
legend2         a string for the second line of the legend
content-only    T or NIL sets if only the plot content is shown

VARIABLE-LABELS (or WAY-LABELS) and POINT-LABELS
Variables (or ways, on some graphs) and points can be labeled with the VARIABLE-LABELS (or WAY-LABELS) and POINT-LABELS keywords (some graphs accept :WAY-LABELS as an alias of :VARIABLE-LABELS, and some don't support :POINT-LABELS). Each argument is followed by a list of the appropriate number of strings.

IN
By default, each plot will appear as an independent window (i.e., not inside a container window) when it is created. If :IN is used, the new graphic will appear inside a container window. If a menu item is used to create the graphic, IN will be set by the menuing system to direct the graph to the appropriate container.The container will be:
  1: CONTAINER if IN is CONTAINER
  2: XLISPSTAT if IN is NIL 
  3: *ACTIVE-CONTAINER* if both IN and *ACTIVE-CONTAINER* are T
Note that for case 3 it can be tricky to determine where the graph appeared if the container is not visible.

SHOW, LOCATION, SIZE, TOP-MOST
The plot will not be shown when :SHOW is NIL until it is sent the message :SHOW-WINDOW. When the window appears it will be be at LOCATION (which is relative to the window's container, if there is one) and be of size SIZE. The graphic will be :TOP-MOST by default. Note that the graphic will not be seen when it appears if its containing window is closed, minimized, located off-screen, or obscurred by another window.

TITLE, MENU, LEGEND1, LEGEND2, GO-AWAY and CONTENT-ONLY
Each plot can have a menu, title, and two legends. It will have a close box which is inoperable when :GO-AWAY is NIL. When :CONTENT-ONLY is T there will be no overlays, button-bars, legends, etc., which is useful if the graph is part of a large spreadplot. 

  _____________________________________________________________________
 |#


  (setf *free-plots* *desktop-container*)
  (setf *plot-menu-hot-spot* t)
  (setf *mosaic-bargraph-max-level*  64)
  (setf *mosaic-bargraph-max-cells* 144)
  (setf *mosaic-bargraph-max-ways*    4)


(defun graph-frame (&rest args) 
  (enable-container *desktop-container*)
  *desktop-container*)



  (defun before-new-plot (data &optional ok-var-types)
    "ARGS: DATA &OPTIONAL OK-VAR-TYPES
Prepares data for input to a graphics module. DATA may be NIL, a DATA OBJECT, a LIST of numeric or string elements, a list of variable objects, a VECTOR, a LIST OF LISTS, a LIST OF VECTORS, or a MATRIX. OK-VAR-TYPES  is an optional VAR-TYPES specifier that is needed when DATA is NIL or a DATA OBJECT. Returns a list with three or four elements. The first element is a list of lists or a list of vectors of data, each sublist or vector being data for a variable. Second element is variable names. Third element is observations labels. Fourth element is data-object identification. Second, third and fourth element may be nil."
    (flet ((outlist (n str) (mapcar #'(lambda (i) 
                                    (format nil "~a~a" str i)) 
                                (iseq n)))
           )
      (let* ((variable-labels) 
             (point-labels) 
             (title) 
             (result))
        (unless data (setf data $))
        (setf result
              (cond
                ((objectp data)                                   ;data is an object
                 (list 
                  (send data :active-data-vectors ok-var-types)
                  (send data :active-variables ok-var-types)
                  (send data :active-labels)
                  data))
                ((matrixp data)                                   ;data is a matrix
                 (list (column-list data) 
                       (outlist (array-dimension 1) "Col")
                       (outlist (array-dimension 0) "Row")))
                ((listp data)                                     ;data is a list of ...
                 (cond
                   ((or (numberp (first data))                         ; ... numbers
                        (stringp (first data)))                        ; ... strings
                    (list (list data) 
                          (list "Var1") 
                          (outlist (length data) "Obs")))
                   ((variablep (first data))                           ; ... vista variables
                    (list data nil nil))
                   ((vectorp (first data))                             ; ... vectors
                    (list data (list "Vec1") (outlist (length data) "Elmnt")))
                   ((and (listp data)   (not (sequencep (first data)))) 
                    (list (list data) (list "Var1") (outlist (length data) "Obs")))
                   ((and (vectorp data) (not (sequencep (select data 0)))) 
                    (list (list data) (list "Var1") (outlist (length data) "Obs")))
                   (t
                    (fatal-message "Data cannot be converted into graph-data"))))
                (t (fatal-message "Data cannot be converted into graph-data"))))
      ;(unless (second result)
      ;        (setf (second result) (mapcar #'(lambda (i) (format nil "Var~a" i))
      ;                                      (iseq (length (first result)))))
      ;        (setf (third result) (mapcar #'(lambda (i) (format nil "Obs~a" i))
      ;                                     (iseq (length (first (first result)))))))
        result)))
  

  (defmeth container-proto :seen-in (in in?)
    "Args IN IN?
Determines where windows will be seen and returns value indicating where this is. IN can be T, NIL, or a container window object. IN? can be T or NIL. Will be seen on the Desktop if IN? is NIL or if none of the following conditions hold: Will be seen in IN if IN is a container object; in *ACTIVE-CONTAINER* if IN is T and there is an active container; or in the XLISPSTAT window if IN is NIL. Returns T, NIL or IN, meaning the window will appear on the DESKTOP, in XLISPSTAT or in CONTAINER, respective"
    (cond 
      ((not in?)    (enable-container self)   t)   ;desktop
      ((not in)     (disable-container)      nil)  ;xlispstat
      ((objectp in) (enable-container in)     in)  ;IN
      ((and (equal t in) 
            (objectp *active-container*))    *active-container*) ;*active-container*
      (t            (enable-container self)   t)   ;desktop
      ))


(defmeth container-proto :graphs (&optional (num nil set))
  "Message args: (&optional num)
 Sets or retrieves the number of graphs for graph location."
  (unless (send self :has-slot 'graphs)
          (send self :add-slot 'graphs))
  (if set (setf (slot-value 'graphs) num))
  (slot-value 'graphs))


(defmeth container-proto :after-new-plot (pop-out top-most show plot size actcon)
  (when plot
        (send self :graphs (append (send self :graphs) (list plot)))
        (send plot :after-new-plot pop-out top-most show size actcon)
        (if actcon 
            (enable-container actcon)
            (disable-container)))
  plot)

(defmeth container-proto :after-new-container (pop-out top-most show size actcon)
    (unless (send actcon :n-graphs) (send actcon :n-graphs 0))
    (send actcon :n-graphs (1+ (send actcon :n-graphs)))
    (let* ((menu (send self :menu))
           (floc (* (- (send actcon :n-graphs) 1) '(20 20)))
          ; (overlay (length (send self :overlays)))
           )
     ; (ignore-errors 
     ;  (when overlay
     ;        (dotimes (i overlay)
     ;                 (send (select (send self :overlays) i) :remove-button ':pop)
     ;                 (send (select (send self :overlays) i) :remove-button ':zoom))))
      (when (> (+ (first floc) (first size)) (first *effective-screen-size*))
            (send actcon :n-graphs 0)
            (setf (select floc 0) 0))
      (when (> (+ (second floc) (second size)) (second *effective-screen-size*))
            (setf (select floc 1) 
                  (+ (- (second floc) (second *effective-screen-size*)) (second size))))
      (apply #'send self :frame-location floc)
      
      (send self :pop-out-on pop-out)
      (send self :top-most-on top-most)
    ;  (send self :container actcon)
      (when show (apply #'send self :location (+ (send self :location) 2000)))
      (when pop-out 
            (send self :pop-out t)
            (apply #'send self :size size))
      (when menu 
            (send menu :remove)
            (when show (send self :redraw))
            (defmeth self :do-click (x y m1 m2)
              (call-next-method x y m1 m2)
              (when m2 (send (send self :menu) :popup-menu x y self))))
      (when show 
            (apply #'send self :location (- (send self :location) 2000))
            (send self :show-window))
      
      (setf *current-plot* self)
      (setf *cp* self)
      (setf *graph* self)
      self))

(defmeth container-proto :pop-out-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be popped out."
  (unless (send self :has-slot 'pop-out-on)
          (send self :add-slot 'pop-out-on))
  (if set (setf (slot-value 'pop-out-on) logical))
  (slot-value 'pop-out-on)) 


(defmeth container-proto :top-most-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be made to be top most."
  (unless (send self :has-slot 'top-most-on)
          (send self :add-slot 'top-most-on))
  (if set (setf (slot-value 'top-most-on) logical))
  (slot-value 'top-most-on)) 

 (defmeth graph-proto :after-new-plot (pop-out top-most show size actcon)
    (unless (send actcon :n-graphs) (send actcon :n-graphs 0))
    (send actcon :n-graphs (1+ (send actcon :n-graphs)))
    (let* ((menu (send self :menu))
           (floc (* (- (send actcon :n-graphs) 1) '(20 20)))
           (overlay (length (send self :overlays)))
           )
      (ignore-errors 
       (when overlay
             (dotimes (i overlay)
                      (send (select (send self :overlays) i) :remove-button ':pop)
                      (send (select (send self :overlays) i) :remove-button ':zoom))))
      (when (> (+ (first floc) (first size)) (first *effective-screen-size*))
            (send actcon :n-graphs 0)
            (setf (select floc 0) 0))
      (when (> (+ (second floc) (second size)) (second *effective-screen-size*))
            (setf (select floc 1) 
                  (+ (- (second floc) (second *effective-screen-size*)) (second size))))
      (apply #'send self :frame-location floc)
      (send self :pop-out-on pop-out)
      (send self :top-most-on top-most)
      (send self :container actcon)
      (when show (apply #'send self :location (+ (send self :location) 2000)))
      (when pop-out 
            (send self :pop-out t)
            (apply #'send self :size size))
      (when menu 
            (send menu :remove)
            (when show (send self :redraw))
            (defmeth self :do-click (x y m1 m2)
              (call-next-method x y m1 m2)
              (when m2 (send (send self :menu) :popup-menu x y self))))
      (when show 
            (apply #'send self :location (- (send self :location) 2000))
            (send self :show-window))
      (send (send self :menu) :append-items (send dash-item-proto :new))
      (send self :append-always-on-top-menu-item top-most)
      (send self :append-maximize-restore-menu-item)
      (setf *current-plot* self)
      (setf *cp* self)
      (setf *graph* self)
      self))


(defmeth graph-proto :pop-out-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be popped out."
  (unless (send self :has-slot 'pop-out-on)
          (send self :add-slot 'pop-out-on))
  (if set (setf (slot-value 'pop-out-on) logical))
  (slot-value 'pop-out-on)) 


(defmeth graph-proto :top-most-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be made to be top most."
  (unless (send self :has-slot 'top-most-on)
          (send self :add-slot 'top-most-on))
  (if set (setf (slot-value 'top-most-on) logical))
  (slot-value 'top-most-on)) 


(defmeth graph-proto :container (&optional (objid nil set))
"Message args: (&optional logical)
 Sets or retrieves object id of a graph's container, if there is one."
  (unless (send self :has-slot 'container)
          (send self :add-slot 'container))
  (if set (setf (slot-value 'container) objid))
  (slot-value 'container))


; following is in toolmenu.lsp
; adds :set-plot-and-view-menu-item-states to menu item updating


#|
(defmeth mv-data-object-proto :set-menu-item-states 	 
              (menu-length current-item-number current-icon ds-obj ds-open)
"Sets menu states, analysis states, transformation states, menu item states, and toolbar button states using generalized-data-type"
  (initialize-desktop-window-menu t)
  (send self :set-menu&tool-states (send self :generalized-data-type))
  (send create-dob-data-menu-item :enabled t)
  (send delete-data-menu-item :enabled t)
  (send delete-model-menu-item :enabled nil)
  (send impute-missing-data-menu-item :enabled nil)
  (send summarize-data-menu-item :enabled t)
  (send report-data-menu-item :enabled t)
  (send new-data-file-menu-item :enabled t)
  
  (when *plots-menu* (send *plots-menu* :set-vista-menu-item-states self))
  (when *views-menu* (send *views-menu* :set-vista-menu-item-states self))
  (cond
    ((send *vista* :missing-values) 
     (send corr-trans-menu-item :enabled nil)
     (send covar-trans-menu-item :enabled nil)
     (send dist-trans-menu-item  :enabled nil)
     (send orth-trans-menu-item  :enabled nil))
    (t (send *vista* :set-transformation-states (send self :data-type))))
  (when (send *vista* :long-menus)
        (send (select (send *data-menu* :items) current-item-number) :mark t))
  (cond 
    ((send *vista* :missing-values)
     (send visualize-data-menu-item :enabled t);was nil PV
     (send summarize-data-menu-item :enabled t);was nil PV
     (send report-data-menu-item :enabled t);was nil PV
     (send impute-missing-data-menu-item :enabled t))
    ((send current-data :matrices)
     (send merge-vars-menu-item :enabled nil)
     (send merge-obs-menu-item :enabled nil)
     (send visualize-data-menu-item :enabled nil)
     (when previous-data (send merge-mats-menu-item :enabled t))
     (send *vista* :show-mats))
    (t
     (when previous-data 
           (send merge-vars-menu-item :enabled t)
           (send merge-obs-menu-item :enabled t))
     (send *vista*   :show-obs)
     (send merge-mats-menu-item    :enabled nil)
     (send visualize-data-menu-item :enabled t)))
  (if (member "category" 
                (map-elements #'string-downcase  
                              (send self :active-types '(all))) 
                :test #'equal)
      (send freq-tables-data-menu-item :enabled t)
      (send freq-tables-data-menu-item :enabled nil))
  )
|#
